home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1993 July / InfoMagic USENET CD-ROM July 1993.ISO / sources / misc / volume4 / fxref < prev    next >
Encoding:
Text File  |  1989-02-03  |  20.1 KB  |  942 lines
  1. Path: xanth!mcnc!rutgers!gatech!cwjcc!hal!ncoast!allbery
  2. From: silvert@dalcs.UUCP (Bill Silvert)
  3. Newsgroups: comp.sources.misc
  4. Subject: v04i033: fortran cross-reference utilities
  5. Message-ID: <8808191246.AA10446@dalcs.UUCP>
  6. Date: 19 Aug 88 12:46:00 GMT
  7. Sender: allbery@ncoast.UUCP
  8. Reply-To: silvert@dalcs.UUCP (Bill Silvert)
  9. Lines: 930
  10. Approved: allbery@ncoast.UUCP
  11.  
  12. Posting-number: Volume 4, Issue 33
  13. Submitted-by: "Bill Silvert" <silvert@dalcs.UUCP>
  14. Archive-name: fxref
  15.  
  16. This pair of utilities facilitate Fortran programming.
  17. flink generates various displays of the linkages between subprogram
  18. units, while fxref constructs a cross reference map.  fxref is an
  19. update to a program I posted aobut two yeears ago.
  20.  
  21. Warning -- these expect all Fortran expressions to be in upper
  22. case.  Please don't flame me about this, we write standard Fortran.
  23. However, since I have no idea how many group readers use upper case,
  24. I haven't made the effort to write a manual -- run the programs and
  25. see how they work if you are interested.  flink has all kinds of
  26. options (type flink -h for a summary), fxref doesn't.  They both
  27. expect to be fed a list of Fortran source files.
  28.  
  29. You will need lex(1) to create C source code from the *.l files.
  30. The only routine needed from -ll is yywrap(), so that is provided --
  31. you can use lex on a Unix system and then compile on any machine
  32. with a C compiler.  If you don't have lex, I can mail you flink.c
  33. and fxrefa.c, but these are BIG files.
  34.  
  35. ------------------------------ cut here --------------------------
  36. #!/bin/sh
  37. # This is a shell archive, meaning:
  38. # 1. Remove everything above the #!/bin/sh line.
  39. # 2. Save the resulting text in a file.
  40. # 3. Execute the file with /bin/sh (not csh) to create the files:
  41. #    Makefile
  42. #    flink.l
  43. #    fxref
  44. #    fxrefa.l
  45. #    fxrefb.c
  46. #    error.c
  47. #    yywrap.c
  48. # This archive created: Fri Aug 19 09:39:42 1988
  49. # By:    Bill Silvert (Habitat Ecology Div., Bedford Inst. of Oceanography)
  50. export PATH; PATH=/bin:$PATH
  51. if test -f 'Makefile'
  52. then
  53.     echo shar: over-writing existing file "'Makefile'"
  54. fi
  55. cat << \SHAR_EOF > 'Makefile'
  56. # makefile for fxref, the f77 xref program from Bourne 8.2.2
  57.  
  58. CFLAGS = -O
  59.  
  60. all:
  61.     make fxrefa fxrefb flink
  62.  
  63. flink: flink.c error.o yywrap.o
  64.     cc -O -o flink flink.c error.o yywrap.o
  65.  
  66. fxrefa: fxrefa.c yywrap.o
  67.     cc -O -o fxrefa fxrefa.c yywrap.o
  68.  
  69. fxrefb: fxrefb.c
  70.     cc -O -o fxrefb fxrefb.c
  71.  
  72. flink.c: flink.l
  73.     lex flink.l
  74.     mv lex.yy.c flink.c
  75.  
  76. fxrefa.c: fxrefa.l
  77.     lex fxrefa.l
  78.     mv lex.yy.c fxrefa.c
  79.  
  80. clean:
  81.     rm -f flink.c fxrefa.c lex.yy.c Make.rec
  82.     cd SCCS; sccsclean ..
  83. SHAR_EOF
  84. if test -f 'flink.l'
  85. then
  86.     echo shar: over-writing existing file "'flink.l'"
  87. fi
  88. cat << \SHAR_EOF > 'flink.l'
  89. /* flink -- f77 call mapper -- from Bourne's C xref, p. 204 */
  90. /* Written by Bill Silvert, August 1988 */
  91. %k 100
  92. %a 1000
  93. %o 1000
  94. %n 200
  95. %e 200
  96. %p 1000
  97. %{
  98. #undef ECHO
  99. static char SCCSID[] = "@(#)flink.l    Ver. 1.17, 88/08/17 10:11:33";
  100. char *progname, *filename="-";
  101. #define    FWORD    8
  102. #define    ESIZE    10
  103. #define    SKIP    0
  104. #define    PROG    1
  105. #define    SUBR    2
  106. #define    FUNC    3
  107. #define    BLKD    4
  108. #define    ENTR    5
  109. #define    CALL    9
  110. int status = SKIP;    /* flags to define level of name */
  111. char *routine[] = {    "",
  112.             "PROGRAM",
  113.             "SUBROUTINE",
  114.             "FUNCTION",
  115.             "BLOCK DATA",
  116.             "ENTRY",
  117.             "",
  118.             "",
  119.             "",
  120.             "CALL"
  121.           };
  122. #define OPTTBL    0
  123. #define OPTCAL    1
  124. #define OPTDEP    2
  125. #define OPTENT    3
  126. #define OPTFIL    4
  127. #define OPTBLK    5
  128. #define OPTUNU    6
  129. #define OPTUNS    7
  130. #define OPTSUB    8
  131. int option = OPTTBL;
  132. char *select = NULL;        /* name selected as option */
  133. int verbose=1;
  134. int entered=0, linked=0;    /* initialization flags */
  135. char unit[FWORD];
  136. typedef struct element    {    char name[FWORD];
  137.                 char *file;
  138.                 int level;
  139.                 int hit;
  140.                 int class;
  141.                 struct element *next;
  142.             }    ELEMENT;
  143.  
  144. typedef struct matrix    {    ELEMENT *i;
  145.                 ELEMENT *j;
  146.                 struct matrix *next;
  147.             }    MATRIX;
  148.  
  149. /* arrays for data and pointers -- first element of each array is useless */
  150. ELEMENT entry[ESIZE], *lentry=entry+ESIZE-1, *current, *rec;
  151. ELEMENT *newrecord(), *altrecord(), *addrecord();
  152. MATRIX link[ESIZE], *llink=link+ESIZE-1, *index=link;
  153. int type[10];    /* how many subprograms of each type? */
  154.  
  155. main(argc,argv)
  156. int argc;
  157. char *argv[];
  158. {
  159.     extern int optind;
  160.     extern char *optarg;
  161.     int count, ocount;
  162.  
  163.     progname = argv[0];
  164.     strcpy(entry->name, "------");    /* safety defaults */
  165.     entry->next = NULL;
  166.     link->next = NULL;
  167.     for(count=0; count<10; count++)
  168.         type[count] = 0;
  169.     while((count = getopt(argc, argv, "bcdefqstuvxC:D:F:h")) != EOF)
  170.         switch(count) {
  171.         case 'b': option = OPTBLK;    break;
  172.         case 'C': select = optarg;
  173.         case 'c': option = OPTCAL;    break;
  174.         case 'D': select = optarg;
  175.         case 'd': option = OPTDEP;    break;
  176.         case 'e': option = OPTENT;    break;
  177.         case 'F': select = optarg;
  178.         case 'f': option = OPTFIL;    break;
  179.         case 'q': verbose=0;        break;
  180.         case 's': option = OPTSUB;    break;
  181.         case 't': option = OPTTBL;    break;
  182.         case 'u': option = OPTUNU;    break;
  183.         case 'x': option = OPTUNS;    break;
  184.         case 'v': verbose=2;        break;
  185.         case 'h':
  186.         default:
  187.             fprintf(stderr,
  188.                 "%s [-bcdefqtuvx] [-CDF name] file ...\n",
  189.                     progname);
  190.             fprintf(stderr,
  191.                 "\tb\tBLOCK DATA\n\tc\tCALLs\n\td\tDependencies (reverse of CALLs)\n\te\tENTRY points\n\tf\tFiles in which subprograms occur\n\tq\tQuiet mode\n\tt\tTabular output (default)\n\tu\tUnused subroutines\n\tv\tVerbose mode\n\tx\tunsatisfied eXternals\n\tC name\tCALLs from <name>\n\tD name\tDependencies on <name> (what CALLs it)\n\tF name\tFile in which <name> occurs\n");
  192.             exit(1);
  193.         }
  194.     if(optind >= argc) {
  195.         strcpy(unit, "------");
  196.         yylex();
  197.         if(current && verbose)
  198.             fprintf(stderr,
  199.                 "Missing END statement at end of %s %s\n",
  200.                     routine[current->class], current->name);
  201.     }
  202.     else {
  203.         for(; optind < argc; optind++) {
  204.             if(freopen(argv[optind],"r",stdin)==NULL) {
  205.                 fprintf(stderr,"%s: %s: cannot open\n",
  206.                         progname, argv[optind]);
  207.             }
  208.             else {
  209.                 filename=argv[optind];
  210.                 yylineno=1;
  211.                 strcpy(unit, "------");
  212.                 yylex();
  213.                 if(current && verbose) {
  214.                     fprintf(stderr,
  215.             "Missing END statement at end of %s %s in file %s\n",
  216.                         routine[current->class],
  217.                         current->name,
  218.                         filename);
  219.                     current = NULL;
  220.                 }
  221.             }
  222.         }
  223.     }
  224.     /* Now find all of the dependencies */
  225.     switch(type[PROG]) {
  226.     case 0:            /* no main PROGRAM defined */
  227.         status = 1;        /* flag */
  228.         count = 0;        /* test for blank input */
  229.         for(rec = entry; rec->class != SUBR; rec = rec->next) {
  230.             if(! rec->next) {    /* oops -- made it to end */
  231.                 if(! count)
  232.                     error_("No program units in input");
  233.                 /* at this stage, display what we have */
  234.                 status = 0;
  235.                 break;
  236.             }
  237.             else
  238.                 count++;    /* keep track of input */
  239.         }
  240.         if(status)
  241.             rec->level = 1;    /* process first subroutine */
  242.         else
  243.             if(verbose)
  244.             fprintf(stderr, "No PROGRAM or SUBROUTINE in input\n");
  245.         break;
  246.     case 1:            /* usual case */
  247.         break;
  248.     default: if(verbose)
  249.         fprintf(stderr, "There are %d PROGRAM units\n\n", type[PROG]);
  250.     }
  251.     count = type[PROG] + type[FUNC];
  252.     status = 1;    /* change the use of status to a counter */
  253.     do {
  254.         ocount = count;
  255.         if(verbose>1)
  256.             printf("Level %d, count=%d\n", status-1, count);
  257.         status++;
  258.         for(index = link;;index=index->next) {
  259.             if(index->i->level && !index->j->level) {
  260.                 index->j->hit = status;
  261.             }
  262.             if(! index->next) break;
  263.         }
  264.         for(rec=entry;;rec=rec->next) {
  265.             if(rec->hit && ! rec->level) {
  266.                 rec->level = rec->hit;
  267.                 count++;
  268.             }
  269.             if(! rec->next) break;
  270.         }
  271.     } while(count > ocount);
  272.     if(! entered)
  273.         error_("No subprograms encountered");
  274.     /* now generate output */
  275.     switch(option) {
  276.     case OPTTBL:
  277.             tabulate();
  278.             break;
  279.     case OPTCAL:
  280.             if(! linked) error_("No linkages found");
  281.             calls();
  282.             break;
  283.     case OPTDEP:
  284.             if(! linked) error_("No linkages found");
  285.             depends();
  286.             break;
  287.     case OPTENT:
  288.             if(! linked) error_("No linkages found");
  289.             enters();
  290.             break;
  291.     case OPTFIL:
  292.             file();
  293.             break;
  294.     case OPTBLK:
  295.             blocks();
  296.             break;
  297.     case OPTUNU:
  298.             unused();
  299.             break;
  300.     case OPTUNS:
  301.             external();
  302.             break;
  303.     case OPTSUB:
  304.     default:
  305.             errord("Option %d not implemented", option);
  306.     }
  307.     exit(0);
  308. }
  309.  
  310. tabulate()
  311. {
  312.     printf("\nSubroutines called:\nName\tLevel\tFile\n");
  313.     for(rec=entry;;rec=rec->next) {
  314.         int recl;
  315.         recl = rec->class;
  316.         if(rec->file && rec->level && recl != ENTR && recl != FUNC)
  317.             printf("%s\t%d\t%s\n", rec->name, rec->level-1,rec->file);
  318.         if(! rec->next) break;
  319.     }
  320.     if(type[FUNC]) {
  321.         printf("\nFunctions:\nName\tFile\n");
  322.         for(rec=entry;;rec=rec->next) {
  323.             if(rec->file && rec->class == FUNC) {
  324.                 printf("%s\t%s\n", rec->name, rec->file);
  325.                 rec->level++;    /* don't list as unused */
  326.             }
  327.             if(! rec->next) break;
  328.         }
  329.     }
  330.     if(type[ENTR]) {
  331.         printf("\nAlternate entry points:\nName\tFile\n");
  332.         for(rec=entry;;rec=rec->next) {
  333.             if(rec->file && rec->class == ENTR) {
  334.                 printf("%s\t%s\n", rec->name, rec->file);
  335.                 rec->level++;    /* don't list as unused */
  336.             }
  337.             if(! rec->next) break;
  338.         }
  339.     }
  340.     if(type[BLKD]) {
  341.         printf("\nBLOCK DATA subprograms:\nName\tFile\n");
  342.         blocks();
  343.     }
  344.     printf("\nUnused subprograms:\nName\tFile\n");
  345.     if(! unused())
  346.         printf("(none)\n");
  347.     printf("\nUnsatisfied externals:\nName\tLevel\n");
  348.     if(! external())
  349.         printf("(none)\n");
  350.     /* CALLS to subroutines called by unused subprograms are ignored */
  351. }
  352.  
  353. blocks()
  354. {
  355.     for(rec=entry;;rec=rec->next) {
  356.         if(rec->file && rec->class == BLKD) {
  357.             printf("%s\t%s\n", rec->name, rec->file);
  358.             rec->level++;    /* don't list as unused */
  359.         }
  360.         if(! rec->next) break;
  361.     }
  362. }
  363.  
  364. unused()
  365. {
  366.     int k = 0;
  367.     for(rec=entry;;rec=rec->next) {
  368.         if(rec->file && ! rec->level) {
  369.             printf("%s\t%s\n", rec->name, rec->file);
  370.             k++;
  371.         }
  372.         if(! rec->next) break;
  373.     }
  374.     return k;
  375. }
  376.  
  377. external()
  378. {
  379.     int k = 0;
  380.     for(rec=entry;;rec=rec->next) {
  381.         if(rec->level && ! rec->file) {
  382.             printf("%s\t%d\n", rec->name, rec->level-1);
  383.             k++;
  384.         }
  385.         if(! rec->next) break;
  386.     }
  387.     return k;
  388. }
  389.  
  390. calls()
  391. {
  392.     if(verbose>1)
  393.         printf("Name\tSubroutine called\n");
  394.     for(index = link;;index=index->next) {
  395.         if(index->i->class != ENTR)
  396.             if(!select || !strcmp(index->i->name, select))
  397.                 printf("%s\t%s\n", index->i->name,
  398.                         index->j->name);
  399.         if(! index->next) break;
  400.     }
  401. }
  402.  
  403. depends()
  404. {
  405.     if(verbose>1)
  406.         printf("Name\tCalling subroutine\n");
  407.     for(index = link;;index=index->next) {
  408.         if(index->i->class != ENTR)
  409.             if(!select || !strcmp(index->j->name, select))
  410.                 printf("%s\t%s\n", index->j->name,
  411.                         index->i->name);
  412.         if(! index->next) break;
  413.     }
  414. }
  415.  
  416. enters()
  417. {
  418.     if(verbose>1)
  419.         printf("Name\tAlternate ENTRY\n");
  420.     for(index = link;;index=index->next) {
  421.         if(index->i->class == ENTR)
  422.             /* if(!select || !strcmp(index->j->name, select)) */
  423.                 printf("%s\t%s\n", index->j->name,
  424.                         index->i->name);
  425.         if(! index->next) break;
  426.     }
  427. }
  428.  
  429. file()
  430. {
  431.     if(verbose>1)
  432.         printf("Name\tFile\n");
  433.     for(rec=entry;;rec=rec->next) {
  434.         if(rec->file) {
  435.             if(!select || !strcmp(rec->name, select))
  436.                 printf("%s\t%s\n", rec->name, rec->file);
  437.         }
  438.         if(! rec->next) break;
  439.     }
  440. }
  441.  
  442. ELEMENT *newrecord(recname)    /* encounter a new program unit */
  443. char *recname;
  444. {
  445.     if(current&& verbose)
  446.         fprintf(stderr, "%s %s starts before %s %s ends\n",
  447.             routine[status], recname,
  448.             routine[current->class], current->name);
  449.     return altrecord(recname);
  450. }
  451.  
  452. ELEMENT *altrecord(recname)    /* identify program unit or entry point */
  453. char *recname;
  454. {
  455.     ELEMENT *newrec;
  456.     newrec = addrecord(recname);
  457.     if(newrec->file)
  458.         errors("Duplicate declaration of %s", recname);
  459.     newrec->file = filename;
  460.     newrec->class = status;
  461.     return newrec;
  462. }
  463.  
  464. ELEMENT *addrecord(recname)    /* find or create matching entry */
  465. char *recname;
  466. {
  467.     ELEMENT *add;
  468.     if(entered) {
  469.         ELEMENT *next;
  470.         for(add=entry;;add=add->next) {
  471.             if(! strcmp(recname, add->name))
  472.                 return add;
  473.             if(! add->next)    /* end of list? */
  474.                 break;
  475.         }
  476.         if(add < lentry)
  477.                next = add + 1;
  478.         else {
  479.                 next = (ELEMENT *)
  480.                 calloc(ESIZE,sizeof(ELEMENT));
  481.                 lentry += ESIZE;
  482.         }
  483.         add->next = next;
  484.         add = next;
  485.     }
  486.     else {
  487.         entered = 1;
  488.         add = entry;
  489.     }
  490.     strcpy(add->name, recname);
  491.     add->file = NULL;
  492.     add->level = 0;
  493.     add->hit = 0;
  494.     add->class = 0;
  495.     add->next = NULL;
  496.     return add;
  497. }
  498.  
  499. connect(i, j)
  500. ELEMENT *i, *j;
  501. {
  502.     if(linked) {
  503.         MATRIX *next;
  504.         if(index < llink)
  505.             next = index + 1;
  506.         else {
  507.             next = (MATRIX *) calloc(ESIZE, sizeof(MATRIX));
  508.             llink += ESIZE;
  509.         }
  510.         index->next = next;
  511.         index = next;
  512.     }
  513.     else {
  514.         linked = 1;
  515.         index = link;
  516.     }
  517.     index->i = i;
  518.     index->j = j;
  519.     index->next = NULL;
  520. }
  521. %}
  522. %%
  523. ^[C*].*\n            ;    /* skip comments */
  524. ^[ \t]*PROGRAM            status=PROG;
  525. ^[ \t]*SUBROUTINE        status=SUBR;
  526. FUNCTION            status=FUNC;
  527. ^[ \t]*ENTRY            status=ENTR;
  528. ^[ \t]*BLOCK[ \t]*DATA        status=BLKD;
  529. ^[ \t]*END[ \t]*\n        { strcpy(unit, "------"); current = NULL; }
  530. CALL                status=CALL;
  531. ^[ \t]*EXTERNAL            ;
  532. [0-9.]*[ED][-+0-9]*        ;    /* skip floating point numbers */
  533. [A-Z][A-Z0-9]* { switch(status) {
  534.         case PROG:    /* program definition */
  535.             strcpy(unit, yytext);
  536.             current = newrecord(unit);
  537.             current->level = 1;
  538.             break;
  539.         case SUBR:    /* subroutine */
  540.         case BLKD:    /* block data */
  541.             strcpy(unit, yytext);
  542.             current = newrecord(unit);
  543.             break;
  544.         case FUNC:    /* function */
  545.             strcpy(unit, yytext);
  546.             current = newrecord(unit);
  547.             current->level = 1;    /* assume function is used */
  548.             break;
  549.         case ENTR:    /* entry point */
  550.             strcpy(unit, yytext);
  551.             connect(altrecord(unit), current);
  552.             break;
  553.         case CALL:    /* call */
  554.             if(current)
  555.                 connect(current, addrecord(yytext));
  556.             else
  557.                 errors("CALL %s with no current subprogram",
  558.                     yytext);
  559.             break;
  560.         default:
  561.             break;
  562.         } ++type[status]; status = SKIP; }
  563. .    ;
  564. \n    status=SKIP;
  565. SHAR_EOF
  566. if test -f 'fxref'
  567. then
  568.     echo shar: over-writing existing file "'fxref'"
  569. fi
  570. cat << \SHAR_EOF > 'fxref'
  571. :
  572. # f77 xref based on Bourne 8.2.2
  573. LIB=/usr/local/etc
  574. # The following is for testing:
  575. LIB=.
  576. case $# in
  577. 0)    ;;
  578. *)    case $1 in
  579.     -w*)    arg=$1 ; shift ;;
  580.     -*)    echo "`basename $0: do not understand $1`" ; exit 1 ;;
  581.     *)    arg= ;;
  582.     esac
  583. esac
  584. $LIB/fxrefa $* | sort -ut: +0 -1 +1 -2 +2n -3 | $LIB/fxrefb $arg
  585. SHAR_EOF
  586. chmod +x 'fxref'
  587. if test -f 'fxrefa.l'
  588. then
  589.     echo shar: over-writing existing file "'fxrefa.l'"
  590. fi
  591. cat << \SHAR_EOF > 'fxrefa.l'
  592. /* xref.a -- f77 cross reference mapper -- from Bourne's C xref, p. 204 */
  593. %k 100
  594. %a 5000
  595. %o 5000
  596. %n 1000
  597. %e 1500
  598. %p 5000
  599. %{
  600. #undef ECHO
  601. static char SCCSID[] = "@(#)fxrefa.l    Ver. 2.17, 88/08/10 15:11:25";
  602. char *filename="-";
  603. char flag, oldflag, equals;
  604. char firstname[8];    /* where the first name encountered gets stored */
  605.  
  606. main(argc,argv)
  607.     int argc;
  608.     char *argv[];
  609. {
  610.     register int rc=0;
  611.     flag = ' ';
  612.     oldflag = ' ';
  613.     if(argc <= 1) {
  614.         yylex();
  615.     }
  616.     else {
  617.         while(argc > 1) {
  618.             if(freopen(argv[1],"r",stdin)==NULL) {
  619.                 fprintf(stderr,"%s: %s: cannot open\n",
  620.                         argv[0],argv[1]);
  621.                 rc++;
  622.             }
  623.             else {
  624.                 filename=argv[1];
  625.                 yylineno=1;
  626.                 yylex();
  627.             }
  628.             argc--;
  629.             argv++;
  630.         }
  631.     }
  632.     return(rc);
  633. }
  634. %}
  635. %%
  636. AIMAG\ *"("    ;
  637. AINT\ *"("    ;
  638. CABS\ *"("    ;
  639. CCOS\ *"("    ;
  640. CEXP\ *"("    ;
  641. CLOG\ *"("    ;
  642. CMPLX\ *"("    ;
  643. CONJG\ *"("    ;
  644. CSIN\ *"("    ;
  645. CSQRT\ *"("    ;
  646. DABS\ *"("    ;
  647. DATAN\ *"("    ;
  648. DATAN2\ *"("    ;
  649. DBLE\ *"("    ;
  650. DCOS\ *"("    ;
  651. DEXP\ *"("    ;
  652. DLOG\ *"("    ;
  653. DLOG10\ *"("    ;
  654. DMAX1\ *"("    ;
  655. DMIN1\ *"("    ;
  656. DMOD\ *"("    ;
  657. DSIGN\ *"("    ;
  658. DSIN\ *"("    ;
  659. DSQRT\ *"("    ;
  660. IABS\ *"("    ;
  661. IDIM\ *"("    ;
  662. IDINT\ *"("    ;
  663. ALOG\ *"("    ;
  664. ALOG10\ *"("    ;
  665. AMAX0\ *"("    ;
  666. AMAX1\ *"("    ;
  667. AMIN0\ *"("    ;
  668. AMIN1\ *"("    ;
  669. AMOD\ *"("    ;
  670. COMPLEX    flag = 'C';
  671. DOUBLE\ *PRECISION    flag = '#';
  672. IMPLICIT.*\n    oldflag=flag='\0';
  673. ISIGN\ *"("    ;
  674. MAX0\ *"("    ;
  675. MAX1\ *"("    ;
  676. MIN0\ *"("    ;
  677. MIN1\ *"("    ;
  678. ^[C*].*\n    ;            /* skip comments */
  679. FORMAT.*\n    oldflag=flag='\0';    /* and ignore FORMAT statements */
  680. "\'"    {
  681.     while(yyinput() != '\''); /* skip quoted material */
  682.     }
  683. ^"     "[^ ]    flag=oldflag;    /* continuation line */
  684. ABS\ *"("    ;
  685. ".AND."    ;
  686. ATAN\ *"("    ;
  687. ATAN2\ *"("    ;
  688. BACKSPACE    ;
  689. BLOCK\ *DATA    flag = 'h';
  690. CALL        flag = '@';
  691. CHAR\ *"("    ;
  692. ICHAR\ *"("    ;
  693. CHARACTER    flag = '$';
  694. CLOSE\ *"("    ;
  695. COMMON    flag = 'c';
  696. CONTINUE    ;
  697. COS\ *"("    ;
  698. ACOS\ *"("    ;
  699. DATA    flag = 'i';
  700. DIMENSION    flag = 'd';
  701. DO\ [0-9 \t,]*    flag = 'D';
  702. ELSE\ *IF[ \t]*"("    flag = '?';
  703. ELSE    ;
  704. END\ *FILE    ;
  705. END\ *IF    ;
  706. END    ;
  707. ENTRY        flag = 'h';
  708. ".EQ."    ;
  709. EQUIVALENCE\ *"("    flag =  '~';
  710. EXP\ *"("    ;
  711. EXTERNAL    flag =  'x';
  712. ".FALSE."    ;
  713. FILE    ;
  714. FLOAT\ *"("    ;
  715. FUNCTION    flag =  'h';
  716. ".GE."    ;
  717. GO\ *TO    ;
  718. ".GT."    ;
  719. IF\ *"("    flag = '?';
  720. IFIX\ *"("    ;
  721. INDEX\ *"("    ;
  722. INT\ *"("    ;
  723. NINT\ *"("    ;
  724. INTEGER    flag =  '%';
  725. INTERNAL    flag =  'p';
  726. ".LE."    ;
  727. LEN\ *"("    ;
  728. LGE\ *"("    ;
  729. LGT\ *"("    ;
  730. LLE\ *"("    ;
  731. LLT\ *"("    ;
  732. LOG\ *"("    ;
  733. LOG10\ *"("    ;
  734. LOGICAL    flag = 'L';
  735. ".LT."    ;
  736. MAX\ *"("    ;
  737. MIN\ *"("    ;
  738. MOD\ *"("    ;
  739. ".NE."    ;
  740. ".NOT."    ;
  741. ".OR."    ;
  742. OPEN\ *"("    flag = 'o';
  743. PARAMETER\ *"("    flag =  'p';
  744. PRINT    flag = '>';
  745. PROGRAM    flag = 'h';
  746. READ    flag = '<';
  747. REAL    flag =  '!';
  748. REC    ;
  749. RECL    ;
  750. RETURN    ;
  751. REWIND\ *"("    ;
  752. SAVE    ;
  753. SIGN\ *"("    ;
  754. SIN\ *"("    ;
  755. SQRT\ *"("    ;
  756. STOP    ;
  757. SUBROUTINE    flag = 'h';
  758. TANH\ *"("    ;
  759. THEN    ;
  760. TO    ;
  761. ".TRUE."    ;
  762. WRITE\ *"("    flag = '>';
  763. [0-9.]*[ED][-+0-9]*    ;    /* skip floating point numbers */
  764. [A-Z][A-Z0-9]* { if(flag)    /* at last we come to variable names! */
  765.     if(*firstname)
  766.         printf("%s\t%s\t%03d%c\n", yytext, filename, yylineno, flag);
  767.     else
  768.         strcpy(firstname, yytext); }
  769. =    equals++ ;
  770. .    ;
  771. \n    { if(*firstname) {
  772.         if(equals)
  773.         printf("%s\t%s\t%03d=\n", firstname, filename, yylineno-1);
  774.         else
  775.         printf("%s\t%s\t%03d%c\n", firstname,filename,yylineno-1,flag);
  776.         *firstname = '\0';
  777.       }
  778.       oldflag = flag; flag =  ' '; equals = 0; }
  779. SHAR_EOF
  780. if test -f 'fxrefb.c'
  781. then
  782.     echo shar: over-writing existing file "'fxrefb.c'"
  783. fi
  784. cat << \SHAR_EOF > 'fxrefb.c'
  785. /* second part of f77 xref program.  Developed from Bourne p. 207 */
  786. #include <stdio.h>
  787. static char SCCSID[] = "@(#)fxrefb.c    Ver. 2.4, 88/08/08 15:53:37";
  788. #define MAXW 256
  789. char    lastw[MAXW]; /* last word read */
  790. char    lastc;
  791.  
  792. main(argc,argv)
  793.     int argc;
  794.     char *argv[];
  795. {
  796.     char f1[MAXW], f2[MAXW];
  797.     char first=0;
  798.     int width, col=0;
  799.  
  800.     switch(argc) {
  801.     case 1:
  802.         width=80; /* default */
  803.         break;
  804.     case 2:
  805.         if(sscanf(argv[1], "-w%d", &width) == 1) {
  806.             width = 5 * (width / 5);
  807.             break;
  808.         }
  809.     default:
  810.         printf("%s: illegal argument\n", argv[0]);
  811.         exit(1);
  812.     }
  813.     f1[0]=0;
  814.     f2[0]=0;
  815.  
  816.     printf("\t\t\tFlags mean:\n");
  817.     printf("h\tprogram unit header  \t");
  818.     printf("p\tPARAMETER definition \n");
  819.     printf("c\tCOMMON statement     \t");
  820.     printf("~\tEQUIVALENCE          \n");
  821.     printf("d\tDIMENSION statement  \t");
  822.     printf("$\tCHARACTER declaration\n");
  823.     printf("L\tLOGICAL declaration  \t");
  824.     printf("%%\tINTEGER declaration  \n");
  825.     printf("!\tREAL declaration     \t");
  826.     printf("#\tDOUBLE PRECISION declaration\n");
  827.     printf("C\tCOMPLEX declaration  \t");
  828.     printf("i\tDATA initialization  \n");
  829.     printf("x\tEXTERNAL             \t");
  830.     printf("@\tCALL                 \n");
  831.     printf("D\tDO loop control      \t");
  832.     printf("?\tIF test              \n");
  833.     printf("=\tassignment statement \t");
  834.     printf("o\tOPEN statement       \n");
  835.     printf("<\tinput                \t");
  836.     printf(">\toutput               \n");
  837.  
  838.     while(word() != EOF) {
  839.         if(lastw[0] != first) {
  840.             first = lastw[0];
  841.             printf("\n");
  842.             col=0;
  843.         }
  844.         if(col >= width) {
  845.             printf("\n                    ");
  846.             col=20;
  847.         }
  848.         if(strcmp(lastw, f1) == 0) {
  849.             word();
  850.             if( ! strcmp(lastw, f2) == 0) {
  851.                 printf("\n          %-10s", lastw);
  852.                 col=20;
  853.                 strcpy(f2, lastw);
  854.             }
  855.         }
  856.         else {
  857.             strcpy(f1, lastw);
  858.             printf("\n%-10s", f1);
  859.             col=10;
  860.             word();
  861.             strcpy(f2, lastw);
  862.             printf("%-10s", f2);
  863.             col += 10;
  864.         }
  865.         if(lastc != '\n') {
  866.             word();
  867.             printf("%5s", lastw);
  868.             col += 5;
  869.         }
  870.         lastc = 0;
  871.     }
  872.     printf("\n");
  873.     exit(0);
  874. }
  875.  
  876. int word()
  877. {
  878.     register char *p=lastw;
  879.     register int c;
  880.  
  881.     if(lastc != '\n') {
  882.         while((c = getchar()) != '\t' && c != '\n' && c != EOF) {
  883.             if(p < &lastw[MAXW])
  884.                 *p++ = c;
  885.         }
  886.         lastc=c;
  887.     }
  888.     *p++ = 0;
  889.     return(lastc);
  890. }
  891. SHAR_EOF
  892. if test -f 'error.c'
  893. then
  894.     echo shar: over-writing existing file "'error.c'"
  895. fi
  896. cat << \SHAR_EOF > 'error.c'
  897. #include <stdio.h>
  898. #include <ctype.h>
  899. extern char *progname;
  900. #define PROG    if(progname)fprintf(stderr,"%s: ",progname)
  901. /* This is the original version:
  902. extern int errno, sys_nerr;
  903. extern char *sys_errlist[];
  904. #define DIE    if(errno>0&&errno<sys_nerr)fprintf(stderr," (%s)",sys_errlist[errno]);fprintf(stderr,"\n");exit(1)
  905. */
  906. #define DIE    fprintf(stderr,"\007\n");exit(1)
  907.  
  908. error_(s) /* print error message and die -- from K&P p. 207 */
  909. char *s;
  910. {
  911.     PROG;
  912.     fprintf(stderr, s);
  913.     DIE;
  914. }
  915. errord(s, d)
  916. char *s;
  917. int d;
  918. {
  919.     PROG;
  920.     fprintf(stderr, s, d);
  921.     DIE;
  922. }
  923. errors(s1, s2)
  924. char *s1, *s2;
  925. {
  926.     PROG;
  927.     fprintf(stderr, s1, s2);
  928.     DIE;
  929. }
  930. SHAR_EOF
  931. if test -f 'yywrap.c'
  932. then
  933.     echo shar: over-writing existing file "'yywrap.c'"
  934. fi
  935. cat << \SHAR_EOF > 'yywrap.c'
  936. yywrap() {        /* required for all LEX programs without -ll */
  937.     return(1);    /* cf. section 9 of Lesk & Schmidt */
  938. }            /* if -ll is available, this comes later */
  939. SHAR_EOF
  940. #    End of shell archive
  941. exit 0
  942.